home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 031-040 / amok31 / task&process / task.mod < prev    next >
Text File  |  1993-11-04  |  3KB  |  103 lines

  1. (*---------------------------------------------------------------------------
  2.    :Program.    Task.mod
  3.    :Contants.   Start Procedure as Task
  4.    :Remark.     Ported from C to Modula-2
  5.    :History.    C-Edition by Arno Gölzer
  6.    :History.    V1.0, M. Peuckert, having spent a lot of time meditating
  7.    :History.    V2.0, M. Peuckert, November 89
  8.    :Author.     Markus Peuckert
  9.    :Address.    Schützenstr. 50, D-3550 Marburg, West-Germany,
  10.    :Copyright.  PD
  11.    :Language.   Modula-2
  12.    :Translator. M2Amiga V3.2d
  13. ---------------------------------------------------------------------------*)
  14.  
  15. MODULE Task;
  16.  
  17. FROM SYSTEM     IMPORT  ADR,ADDRESS,INLINE;
  18. FROM Arts       IMPORT  Assert,TermProcedure,CurrentLevel;
  19. FROM Graphics   IMPORT  RastPortPtr, Move, Text, SetAPen, RectFill, DrawEllipse;
  20. FROM Intuition  IMPORT  IDCMPFlags, IDCMPFlagSet, ScreenFlags, ScreenFlagSet,
  21.                         WindowFlags, WindowFlagSet, WindowPtr, CloseWindow,
  22.                         IntuiMessagePtr;
  23. FROM Dos        IMPORT  Delay;
  24. FROM Exec       IMPORT  GetMsg, ReplyMsg, WaitPort, TaskPtr, PutMsg, FindTask;
  25. FROM ExecSupport IMPORT CreateTask, DeleteTask;
  26. FROM Terminal   IMPORT  WriteString, WriteLn, waitCloseGadget;
  27. FROM IntuiSup   IMPORT  CreateWindow, ActivWindow;
  28.  
  29.  
  30. CONST   TName   = "NewTask";
  31.  
  32. VAR     win, Cwin       : WindowPtr;
  33.         rp, Crp         : RastPortPtr;
  34.         Level           : INTEGER;
  35.         TaskP           : TaskPtr;
  36.         TMsg            : IntuiMessagePtr;
  37.         a               : INTEGER;
  38.  
  39.  
  40. PROCEDURE Cleanup;
  41. BEGIN
  42.  IF Level >= CurrentLevel () THEN
  43.   TaskP := FindTask (ADR(TName));
  44.   IF TaskP#NIL THEN
  45.    DeleteTask (ADR(TaskP));
  46.    WHILE TaskP#NIL DO   TaskP := FindTask (ADR(TName))  END
  47.   END;
  48.   IF win#NIL THEN  CloseWindow (win) END;
  49.  END
  50. END Cleanup;
  51.  
  52. PROCEDURE Function;
  53. VAR i, x, y : INTEGER;
  54. BEGIN
  55.  LOOP
  56.   WaitPort (win^.userPort);     TMsg := GetMsg (win^.userPort);
  57.   SetAPen (rp, a);
  58.   Move (rp, a*5,140);   Text (rp, ADR("Funcky"), 6);
  59.   FOR i:=0 TO 100 DO    RectFill (rp, x, y, x+2*i, y+i) END;
  60.   INC (x, 20);          INC (y, 10);
  61.   IF a>=3 THEN EXIT END
  62.  END
  63. END Function;
  64.  
  65.  
  66. VAR i : INTEGER;
  67. BEGIN
  68.  win:=NIL; waitCloseGadget:=FALSE;
  69.  Level:=CurrentLevel();  TermProcedure(Cleanup);
  70.  
  71.  Cwin := ActivWindow();
  72.  Crp  := Cwin^.rPort;
  73.  
  74.  win:=CreateWindow(300,15,256, 160, IDCMPFlagSet{mouseButtons},
  75.         WindowFlagSet{borderless}, NIL,NIL,NIL,
  76.         ScreenFlagSet{wbenchScreen});
  77.  Assert(win#NIL,ADR("Kann Fenster nicht öffnen"));
  78.  rp:=win^.rPort;
  79.  
  80. (*--------------- Initialisierung abgeschlossen ----------------------------*)
  81.  TaskP := NIL;   TMsg := NIL;
  82.  WriteString ("Aktiviere SubTask ..."); WriteLn;
  83.  TaskP := CreateTask (ADR(TName), 0, ADR(Function), 8000);
  84. (* Ab hier läuft der Task eigenständig *)
  85.  Assert (TaskP#NIL, ADR("Kein Task"));
  86.  win^.userPort^.sigTask := TaskP;
  87.  
  88.  FOR a:=1 TO 3 DO
  89.   PutMsg (win^.userPort, ADR(TMsg)); (* Msg weckt den Task *)
  90.   WriteString ("Noch ein Aufruf"); WriteLn;
  91.  
  92.   FOR i:=0 TO 50 BY 4 DO
  93.    SetAPen (Crp, a);
  94.    DrawEllipse (Crp, 132,90,2*i+2*a, i+a);
  95.    Delay (1)
  96.   END
  97.  END;
  98.  
  99.  Delay (100);
  100.  WriteString ("Beende SubTask ...");
  101.  
  102. END Task.
  103.